home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / ASM / CONS.ASM < prev    next >
Encoding:
Assembly Source File  |  1993-10-08  |  2.2 KB  |  77 lines
  1. ;* CONS.ASM
  2. ;************************************************************************
  3. ;*                                    *
  4. ;*        PC Scheme/Geneva 4.00 Borland TASM code            *
  5. ;*                                    *
  6. ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7. ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8. ;*                                    *
  9. ;*----------------------------------------------------------------------*
  10. ;*                                    *
  11. ;*            Support for Cons                 *
  12. ;*                                    *
  13. ;*----------------------------------------------------------------------*
  14. ;*                                    *
  15. ;* Created by: John Jensen        Date: 1985            *
  16. ;* Revision history:                            *
  17. ;* - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  18. ;*                                    *
  19. ;*                    ``In nomine omnipotentii dei''    *
  20. ;************************************************************************
  21. IDEAL
  22. %PAGESIZE    60, 132
  23. MODEL    medium
  24. LOCALS    @@
  25.  
  26.     INCLUDE    "scheme.ash"
  27.  
  28. CODESEG
  29.  
  30. ;************************************************************************
  31. ;*                                    *
  32. ;*     CONS Support -- combine two pointers in a new list cell        *
  33. ;*            use: cons(result, car, cdr)            *
  34. ;*                                    *
  35. ;************************************************************************
  36. PROC C     cons    USES si di, @@result:word, @@car:word, @@cdr:word
  37.     LOCAL    newreg:REG                  
  38.     mov    bx, [listpage]        ; Attempt a "short circuit" allocation
  39.     shl    bx, 1
  40.     mov    si, [nextcell+bx]     ; load next available cell offset
  41.     cmp    si, END_LIST
  42.     jne    @@available
  43.  
  44.     lea    ax, [newreg]        ; no list cell immediately available
  45.     call    alloc_list_cell C, ax
  46.     mov    bx, [newreg.page]
  47.     mov    si, [newreg.disp]
  48.     ldpage    es, bx            ; new cell at es:si
  49.     jmp    @@startcons
  50.  
  51. @@available:
  52.     ldpage    es, bx
  53.     mov    ax, [(FREELISTDEF es:si).next]
  54.     mov    [nextcell+bx], ax     ;  and update free cell chain header
  55.  
  56. @@startcons:
  57.     mov    di, [@@cdr]           ; store CDR value into list cell
  58.     mov    al, [(REG di).bpage]
  59.     mov    [(LISTDEF es:si).cdr.page], al
  60.     mov    ax, [(REG di).disp]
  61.     mov    [(LISTDEF es:si).cdr.disp], ax
  62.  
  63.     mov    di, [@@car]        ; store CAR value into list cell
  64.     mov    al, [(REG di).bpage]
  65.     mov    [(LISTDEF es:si).car.page], al
  66.     mov    ax, [(REG di).disp]
  67.     mov    [(LISTDEF es:si).car.disp], ax
  68.  
  69.     mov    di, [@@result]        ; store ptr to new list cell in dest
  70.     mov    [(REG di).page], bx
  71.     mov    [(REG di).disp], si
  72.     ret
  73.  
  74. ENDP    cons
  75.  
  76.     END
  77.